
type symbol = Square | Circle | Triangle
type color  = Red | Blue | Yellow | Green | Orange
type cell   = symbol * color * char

let (@@) f x = f x

let symbol () = match Random.int 3 with
    | 0 -> Square
    | 1 -> Circle
    | _ -> Triangle

let color () = match Random.int 5 with
    | 0 -> Red
    | 1 -> Blue
    | 2 -> Yellow
    | 3 -> Green
    | _ -> Orange

let rec insert_at n x xs = match n, xs with
    | 0, xs      -> x::xs
    | k, []      -> failwith "insert_at"
    | k, (y::ys) -> y :: insert_at (n-1) x ys

let permute xs = 
    let rec loop n xs acc = match xs with
        | []    -> acc  
        | x::xs -> loop (n+1) xs (insert_at (Random.int n) x acc) 
    in
        loop 1 xs []

let extra = function 
    | 'i'   -> '!'
    | 'S'   -> '$'
    | 't'   -> '+'
    | 'a'   -> '@'
    | 'O'   -> '0'
    | 'E'   -> '3'
    | 'C'   -> '('
    | 'g'   -> '9'
    |  x    -> x
    
let char n =    
    let uppercase () = Random.int 2 = 0 in 
        extra @@ if uppercase ()
        then Char.chr (Char.code 'A' + n)
        else Char.chr (Char.code 'a' + n) 

let num n = Char.chr @@ Char.code '0' + n

let nums () =    
   let rec loop  = function
        | 0 -> []
        | n -> num (n-1) :: loop (n-1)
    in
        permute @@ loop 10

let chars () =
   let rec loop  = function
        | 0 -> []
        | n -> char (n-1) :: loop (n-1)
    in
        permute @@ loop 25


let symbol_str c = function
    | Square   -> Printf.sprintf "[%c]" c
    | Circle   -> Printf.sprintf "(%c)" c
    | Triangle -> Printf.sprintf "<%c>" c

let color_str = function
    | Red       -> "\027[31m"
    | Blue      -> "\027[32m"
    | Yellow    -> "\027[33m"
    | Green     -> "\027[34m"    
    | Orange    -> "\027[35m"

let cell char = symbol (), color (),char 
let cell_str (s,k,c) = 
    Printf.sprintf "%s%s" (color_str k) (symbol_str c s)

let cell_cmp (s1,k1,c1) (s2,k2,c2) = 
    compare (color_str k1) (color_str k2)

let line color symbol =
    Printf.printf "%s%s\n" 
        (cell_str (symbol,color,' '))
        (  String.concat ""
        @@ List.map cell_str
        @@ List.sort cell_cmp 
        @@ List.map cell 
        @@ chars ()
        )

let main () =
    let () = Random.self_init () in
    let group color = List.iter (line color) [Square; Circle; Triangle] in
        List.iter group [Red; Blue; Yellow; Green; Orange]

let () = if !Sys.interactive then () else main ()    
